unit uSBDUnit_TestEngine;
interface
uses uSBDUnit_TestNode_InternalSupport, uSBD_BaseTypes, uSBDUnit_Model,
     uSBD_ServiceProvider, uSBDUnit_TestScheduler, uSBDUnit_View,
     uSBDUnit_TestPointIteration, Classes, uSBDUnit_Types, Contnrs;

type
TTestEngine = class( TSBD_NonCountedCommonBase, ITestEngine,
    ITestEngine_ViewRegistrar, ITestSchedulerClient, INodeMaster)
  private
    FRoot: ITestNodeRootEx;
    FScheduler: ITestScheduler;
    FIterator: ITestEnumerableGetter;
    FViews: IInterfaceList;
    FisRunning: boolean;
    FTestSuiteClasses: TClassList;
    FClientCallback: IControllerFeedback;
    FWindowClient:  IMainThreadedWindowedClient;
    FStopOnFirstFail: boolean;
    WindowedClientCookie: integer;
    FNodeMasterCookie: integer;
    FStarted: boolean;

    procedure RegisterView ( const View: IUnitTestView);
    procedure DeregisterView( const View: IUnitTestView);
    function  GetStopOnFirstFail: boolean;
    procedure SetStopOnFirstFail( Value: boolean);
    procedure StartUp;
    procedure ShutDown;
    function  Can_ShutDown: boolean;
    function  Root: ITestNode;
    procedure Run;
    function  Can_Run: boolean;
    procedure Clear;
    function  Can_Clear: boolean;
    procedure Abort;
    function  Can_Abort: boolean;
    function  isRunning: boolean;
    procedure RegisterTestSuite( Cls: TClass);
    procedure SetControllerClient( const ClientCallback1: IControllerFeedback);
    procedure NodeStatusChanged( Node: ITestPoint);
    procedure EnginePropsChanged( Changes: TEnginePropSet);
    procedure RunStatusPotentiallyChanged;
    function  DoContinue: boolean; // False if user abort.
    procedure NodePropertiesChanged( const Node: ITestNode; ChangeSet: TChangeableNodePropertySet);
    procedure NonFailMessageArrived( const Node: ITestNode; Idx: integer);
    procedure AddedNode( const Addend: ITestNode);
    function  Started: boolean;
    procedure Failure( const Node: ITestCaseNode; const ErrMessage: string; WhenFailed: TDateTime);

  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation














uses uSBD_ModelServiceRego, uSBDUnit_HierarchyToLinearView, SysUtils,
     uSBDUnit_JobMill;

{ TTestEngine }

constructor TTestEngine.Create;
var
  Converter: IHierarchyToLinearView_Converter;
  RootNode: ITestNodeRootEx;
begin
FViews := TInterfaceList.Create;
FisRunning := False;
FStopOnFirstFail := True;
FTestSuiteClasses := TClassList.Create;
FServiceProvider := MakeStockProvider;
RegisterAllServicesForModel( FServiceProvider);
FNodeMasterCookie := FServiceProvider.RegisterLiveService( INodeMaster, self as INodeMaster);
FRoot := nil;
if AcquireService( ITestNode, RootNode, 'nkRoot') then
   Supports( RootNode, ITestNodeRootEx, FRoot)
end;



procedure TTestEngine.SetControllerClient(
  const ClientCallback1: IControllerFeedback);
var
  Mill: IJobMill;
begin
if FClientCallback = ClientCallback1 then exit;
with FServiceProvider do
  begin
  if Assigned( FWindowClient) then
    DeregisterService( WindowedClientCookie);
  FClientCallback := ClientCallback1;
  FWindowClient := nil;
  if Supports( FClientCallback, IMainThreadedWindowedClient, FWindowClient) then
    WindowedClientCookie := RegisterLiveService( IMainThreadedWindowedClient, FWindowClient);
  if not Assigned( FScheduler) then
    begin
    RegisterLiveService( ITestNode, FRoot as ITestNode, 'EnumerationRoot');
    RegisterLiveService( ITestSchedulerClient, self as ITestSchedulerClient)
    end;
  AcquireService( ITestScheduler, FScheduler)
  end;
end;

procedure TTestEngine.RegisterTestSuite( Cls: TClass);
begin
if Assigned( Cls) and (FTestSuiteClasses.IndexOf( Cls) = -1) then
  if Cls.isValidTestSuiteClass then
      FTestSuiteClasses.Add( Cls)
    else
      RaiseExceptionFmt( '%s needs to inherit from TTestSuite or support ITestSuite and contain at least one test case.', [Cls.ClassName])
end;


function TTestEngine.Started: boolean;
begin
result := FStarted
end;

procedure TTestEngine.StartUp;
var
  Cls: TClass;
  pntrCls: pointer;
  Node: ITestNode;
  Parent, Child: ITestNodeEx;
  TestSuiteNode: ITestSuiteNodeEx;
  sSuiteName: string;
  P, j: integer;
  sGroup: string;
begin
(self as INodeMaster).AddedNode( FRoot as ITestNode);
for pntrCls in FTestSuiteClasses do
  begin
  Cls := TClass( pntrCls);
  sSuiteName    := Cls.SuiteName;
  Parent        := FRoot as ITestNodeEx;
  TestSuiteNode := nil;
  repeat
    P := Pos('.',sSuiteName);
    if P > 0 then
        begin
        sGroup := Copy( sSuiteName, 1, P-1);
        Delete( sSuiteName, 1, P)
        end
      else
        sGroup := '';
    if sGroup <> '' then
        begin
        Child := nil;
        for j := 0 to Parent.Count - 1 do
          begin
          if (Parent.Children[j].Name <> sGroup) or
             (Parent.Children[j].Kind <> nkTestGroup) then continue;
          Child := Parent.Children[j] as ITestNodeEx;
          break
          end;
        if Assigned( Child) then
            Parent := Child
          else
            Parent := Parent.AddNewChild( nkTestGroup, sGroup) as ITestNodeEx
        end
      else
        TestSuiteNode := Parent.AddNewChild( nkTestSuite, sSuiteName) as ITestSuiteNodeEx
  until assigned( TestSuiteNode);
  TestSuiteNode.SetSuiteClass( Cls);
  TestSuiteNode.Clear;
  end;
FServiceProvider.DeregisterService( FNodeMasterCookie);
FRoot.SetEnabledDeep( True);
FStarted := True;
EnginePropsChanged( [propStarted]);
end;


procedure TTestEngine.DeregisterView( const View: IUnitTestView);
begin
if FViews.IndexOf( View) = -1 then exit;
FViews.Remove( View);
View.Notify_EngineObserver( self, False)
end;

destructor TTestEngine.Destroy;
begin
FTestSuiteClasses.Free;
inherited
end;

function TTestEngine.GetStopOnFirstFail: boolean;
begin
result := FStopOnFirstFail
end;

procedure TTestEngine.RegisterView( const View: IUnitTestView);
begin
if Assigned( View) then
  begin
  FViews.Add( View);
  View.Notify_EngineObserver( self, True)
  end;
end;

function TTestEngine.Root: ITestNode;
begin
result := FRoot as ITestNode
end;

procedure TTestEngine.RunStatusPotentiallyChanged;
var
  View: IUnitTestView;
  j: integer;
begin
if FisRunning and FScheduler.isDone then
  begin
  FisRunning := False;
  EnginePropsChanged( [propIsRunning])
  end
end;


procedure TTestEngine.SetStopOnFirstFail( Value: boolean);
begin
if FStopOnFirstFail = Value then exit;
FStopOnFirstFail := Value;
EnginePropsChanged( [propOptions])
end;


procedure TTestEngine.ShutDown;
var
  View: IUnitTestView;
  j: integer;
begin
for j := FViews.Count - 1 downto 0 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_EnginePropsChanged( self, [propShutdown]);
FRoot.ShutDown;
FScheduler := nil;
FIterator  := nil;
for j := FViews.Count - 1 downto 0 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_EngineObserver( self, False);
FViews     := nil;
FClientCallback := nil;
FWindowClient := nil
end;



procedure TTestEngine.Run;
begin
Clear;
FisRunning := True;
EnginePropsChanged( [propIsRunning]);
FScheduler.Run( FStopOnFirstFail)
end;



function TTestEngine.Can_ShutDown: boolean;
begin
result := not FisRunning
end;

procedure TTestEngine.Clear;
begin
FRoot.Clear
end;

function TTestEngine.isRunning: boolean;
begin
result := FisRunning
end;


function TTestEngine.Can_Run: boolean;
begin
result := (not FisRunning) and (FRoot.Count > 0)
end;


function TTestEngine.DoContinue: boolean;
begin
result := (not assigned( FClientCallback)) or (not FClientCallback.DoUserAbort)
end;


procedure TTestEngine.EnginePropsChanged( Changes: TEnginePropSet);
var
  View: IUnitTestView;
  j: integer;
begin
for j := 0 to FViews.Count - 1 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_EnginePropsChanged( self as ITestEngine, Changes)
end;

procedure TTestEngine.Failure(
  const Node: ITestCaseNode; const ErrMessage: string; WhenFailed: TDateTime);
var
  View: IUnitTestView;
  j: integer;
begin
for j := 0 to FViews.Count - 1 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_TestFailure( self as ITestEngine, Node, ErrMessage, WhenFailed)
end;


procedure TTestEngine.Abort;
begin
end;

procedure TTestEngine.AddedNode( const Addend: ITestNode);
var
  View: IUnitTestView;
  j: integer;
begin
for j := 0 to FViews.Count - 1 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_AddedNode( self as ITestEngine, Addend);
end;

function TTestEngine.Can_Abort: boolean;
begin
result := False
end;

function TTestEngine.Can_Clear: boolean;
begin
result := True
end;


procedure TTestEngine.NodePropertiesChanged(
  const Node: ITestNode; ChangeSet: TChangeableNodePropertySet);
var
  View: IUnitTestView;
  j: integer;
begin
for j := 0 to FViews.Count - 1 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_MainViewPropertiesChanged( self as ITestEngine, Node, ChangeSet)
end;


procedure TTestEngine.NodeStatusChanged( Node: ITestPoint);
var
  TrueNode: ITestNode;
begin
if Supports( Node, ITestNode, TrueNode) then
  NodePropertiesChanged( TrueNode, [propExecResult, propStatus])
end;


procedure TTestEngine.NonFailMessageArrived(
  const Node: ITestNode; Idx: integer);
var
  View: IUnitTestView;
  j: integer;
begin
for j := 0 to FViews.Count - 1 do
  if Supports( FViews[j], IUnitTestView, View) then
    View.Notify_NonFailMessageLogged( self as ITestEngine, Node, Idx)
end;


end.
